# print link to github repo if anyif (file.exists("./.git/config")){ config <-readLines("./.git/config") url <-grep("url", config, value =TRUE) url <-gsub("\\turl = |.git$", "", url)cat("\nSource code and data found at [", url, "](", url, ")", sep ="") }
Source code and data found at
Code
# options to customize chunk outputsknitr::opts_chunk$set(tidy.opts =list(width.cutoff =65), tidy =TRUE,message =FALSE )# funnction to print tables in html format print_kable <-function(x) { kb <-kable(x, row.names =TRUE, digits =4, "html") kb <-kable_styling(kb,bootstrap_options =c("striped", "hover", "condensed", "responsive"))scroll_box(kb, width ="100%")}
Purpose
Quantify contribution of different social levels of organization in the geographic variation of thick-billed parrots calls.
Report overview
You can have the sections listed here, for instance:
flowchart
A[Read data] --> B(Create extended<br>selection tables)
B --> C(Measure acoustic<br>features)
C --> D(Explore acoustic spaces)
style A fill:#44015466
style B fill:#3E4A894D
style C fill:#26828E4D
style D fill:#6DCD594D
Load packages
Code
# knitr is require for creating html/pdf/word reports formatR is# used for soft-wrapping code# install/ load packagessketchy::load_packages(packages =c("knitr", "formatR", "warbleR","ggplot2", "maRce10/PhenotypeSpace"))
tbp_calls <-readRDS("./data/processed/extended_selection_table_tpb_calls.rds")# cross correlationtbp_xc <- warbleR::cross_correlation(X = tbp_calls, ovlp =70, bp =c(0.1,8), parallel =20)# save resultssaveRDS(tbp_xc, file ="./data/processed/cross_correlation_tpb_calls.rds")# mfccstbp_mfcc <- warbleR::mfcc_stats(X = tbp_calls, ovlp =70, bp =c(0.1,8), parallel =20)# save resultssaveRDS(tbp_mfcc, file ="./data/processed/mfcc_tpb_calls.rds")# mfccstbp_spft <- warbleR::spectro_analysis(X = tbp_calls, ovlp =70, bp =c(0.1,8), parallel =20)# save resultssaveRDS(tbp_spft, file ="./data/processed/spectral_features_tpb_calls.rds")
3 Explore acoustic spaces
Using cross-correlation:
Code
tbp_xc <-readRDS("./data/processed/cross_correlation_tpb_calls.rds")tbp_calls <-readRDS("./data/processed/extended_selection_table_tpb_calls.rds")tbp_mds <-cmdscale(tbp_xc, k =2)tbp_calls$MDS1 <- tbp_mds[, 1]tbp_calls$MDS2 <- tbp_mds[, 2]ss_type <-space_similarity(type ~ MDS1 + MDS2, data =as.data.frame(tbp_calls),method ="density.overlap")# graph bidimensional space with gpplot coloring by typeggplot(tbp_calls, aes(x = MDS1, y = MDS2, color = type)) +geom_point() +scale_colour_viridis_d(option ="G", begin =0.2, end =0.8, name ="Call type") +theme_classic(base_size =20) +labs(title =paste0("Mean density overlap:",round(ss_type$mean.overlap, 2)), x ="MDS1", y ="MDS2")
Code
ss_type_barks <-space_similarity(Site ~ MDS1 + MDS2, data =as.data.frame(tbp_calls[tbp_calls$type =="barks", ]), method ="density.overlap")ss_type_laughs <-space_similarity(Site ~ MDS1 + MDS2, data =as.data.frame(tbp_calls[tbp_calls$type =="laughs", ]), method ="density.overlap")mean_ovlp <-mean(c(ss_type_barks$mean.overlap, ss_type_laughs$mean.overlap))ggplot(tbp_calls, aes(x = MDS1, y = MDS2, color = Site)) +geom_point() +scale_colour_viridis_d(option ="G", begin =0.2, end =0.8, name ="Site") +theme_classic(base_size =20) +facet_grid(~type, scales ="free") +labs(title =paste0("Mean density overlap:", round(mean_ovlp,2)), x ="MDS1", y ="MDS2")
Using MFCCs:
Code
tbp_mfcc <-readRDS("./data/processed/mfcc_tpb_calls.rds")# pcapca <-prcomp(tbp_mfcc[, -c(1:2)], center =TRUE, scale. =TRUE)tbp_calls$PC1.mfcc <- pca$x[, 1]tbp_calls$PC2.mfcc <- pca$x[, 2]ss_type <-space_similarity(type ~ PC1.mfcc + PC2.mfcc, data =as.data.frame(tbp_calls),method ="density.overlap")# graph bidimensional space with gpplot coloring by typeggplot(tbp_calls, aes(x = PC1.mfcc, y = PC2.mfcc, color = type)) +geom_point() +scale_colour_viridis_d(option ="G", begin =0.2,end =0.8, name ="Call type") +theme_classic(base_size =20) +labs(title =paste0("Mean density overlap:", round(ss_type$mean.overlap,2)), x ="PC1", y ="PC2")
Code
ss_type_barks <-space_similarity(Site ~ PC1.mfcc + PC2.mfcc, data =as.data.frame(tbp_calls[tbp_calls$type =="barks", ]), method ="density.overlap")ss_type_laughs <-space_similarity(Site ~ PC1.mfcc + PC2.mfcc, data =as.data.frame(tbp_calls[tbp_calls$type =="laughs", ]), method ="density.overlap")mean_ovlp <-mean(c(ss_type_barks$mean.overlap, ss_type_laughs$mean.overlap))ggplot(tbp_calls, aes(x = PC1.mfcc, y = PC2.mfcc, color = Site)) +geom_point() +scale_colour_viridis_d(option ="G", begin =0.2,end =0.8, name ="Site") +theme_classic(base_size =20) +facet_grid(~type,scales ="free") +labs(title =paste0("Mean density overlap:",round(mean_ovlp, 2)), x ="PC1", y ="PC2")
Using spectral features:
Code
tbp_spft <-readRDS("./data/processed/spectral_features_tpb_calls.rds")# pcapca <-prcomp(tbp_spft[, -c(1:2)], center =TRUE, scale. =TRUE)tbp_calls$PC1.spft <- pca$x[, 1]tbp_calls$PC2.spft <- pca$x[, 2]ss_type <-space_similarity(type ~ PC1.spft + PC2.spft, data =as.data.frame(tbp_calls),method ="density.overlap")# graph bidimensional space with gpplot coloring by typeggplot(tbp_calls, aes(x = PC1.spft, y = PC2.spft, color = type)) +geom_point() +scale_colour_viridis_d(option ="G", begin =0.2,end =0.8, name ="Call type") +theme_classic(base_size =20) +labs(title =paste0("Mean density overlap:", round(ss_type$mean.overlap,2)), x ="PC1", y ="PC2")
Code
ss_type_barks <-space_similarity(Site ~ PC1.spft + PC2.spft, data =as.data.frame(tbp_calls[tbp_calls$type =="barks", ]), method ="density.overlap")ss_type_laughs <-space_similarity(Site ~ PC1.spft + PC2.spft, data =as.data.frame(tbp_calls[tbp_calls$type =="laughs", ]), method ="density.overlap")mean_ovlp <-mean(c(ss_type_barks$mean.overlap, ss_type_laughs$mean.overlap))ggplot(tbp_calls, aes(x = PC1.spft, y = PC2.spft, color = Site)) +geom_point() +scale_colour_viridis_d(option ="G", begin =0.2,end =0.8, name ="Site") +theme_classic(base_size =20) +facet_grid(~type,scales ="free") +labs(title =paste0("Mean density overlap:",round(mean_ovlp, 2)), x ="PC1", y ="PC2")
Takeaways
MFCCs seem to do a better job at capturing the acoustic variation in thick-billed parrots calls than cross-correlation and spectral features.